home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / longjmp.zip / LONGJMP.PAS < prev   
Pascal/Delphi Source File  |  1993-01-04  |  3KB  |  105 lines
  1. {$K-} { probably better to run with stack checking set off, at this point }
  2.  
  3. {---------- LONGJMP/ SETJMP PACKAGE ----------------------------------}
  4. { Author: Sammy Mitchell }
  5. { Feb 18, 1986 }
  6. { I have tested this program, and it seems to work.  However, use it }
  7. { at your own risk! }
  8.  
  9. { I am not responsible, and my company is not responsible, but my keyboard }
  10. { well... }
  11.  
  12. { If you have any changes or additions, then please upload them so that }
  13. { all of us can share them!  Thanks }
  14.  
  15. { If you have any questions or problems, then I can be reached at:
  16.   all area code 404
  17.   PC-Exchange 977-6686
  18.   TJ's        394-1756 or
  19.   C & Turbo Exchange 441-9702 }
  20.  
  21. { NOTES: SetJmp MUST be called BEFORE LongJmp.  LongJmp MUST NOT be called }
  22. {        LongJmp MUST be called BEFORE the function that called SetJmp }
  23. {        returns.                                                      }
  24.  
  25. {---------- do NOT touch these variables - they are necessary for the
  26.             setjmp/longjmp routines ----------------------------------}
  27. var
  28.   dest,               { longjmp address }
  29.   savesp,             { to restore environment }
  30.   savebp   : integer; { ditto }
  31. {---------- end of setjmp/longjmp variables --------------------------}
  32.  
  33. procedure longJmp;
  34. { Restore the environment, then jump to the location set by a previously }
  35. { called SetJmp command }
  36. begin
  37.   Inline(
  38.    $FA                        { cli          ;lets not get interrupted }
  39.   /$8B/$26/savesp             { mov sp,savesp;restore stack pointer    }
  40.   /$8B/$2E/savebp             { mov bp,savebp;and base pointer       }
  41.   /$FB                        { sti          ;alrite to get interrupted now }
  42.   /$A1/dest                   { mov ax,dest  ;where we want to jump to      }
  43.   /$FF/$E0  );                { jmp ax       ;and go there                }
  44. end;
  45.  
  46. procedure SetJmp;
  47. { Save the current Evironment and set the return address for LongJmp Calls }
  48. begin
  49.   Inline(
  50.    $8B/$E5                    { mov sp,bp    ;restore stack pointer }
  51.   /$5D                        { pop bp       ;and base page pointer }
  52.   /$58                        { pop ax       ;get return address    }
  53.   /$89/$26/savesp             { mov savesp,sp;save stack pointer for longjmp }
  54.   /$89/$2E/savebp             { mov savebp,bp;save base pointer for longjmp }
  55.   /$A3/dest                   { mov dest,ax  ;save return address for longjmp }
  56.   /$FF/$E0  );                { jmp ax       ;now just return               }
  57. end;
  58. {----------------- END LONGJMP/ SETJMP PACKAGE ----------------------------}
  59.  
  60.  
  61. { demo program to illustrate LongJmp/SetJmp usage }
  62. var
  63.   HereBefore : boolean;
  64.  
  65. procedure test3;
  66. begin
  67.   writeln('In test3 - calling LongJmp');
  68.   LongJmp;
  69. end;
  70.  
  71. procedure test2;
  72. begin
  73.   writeln('In test2');
  74.   test3;
  75. end;
  76.  
  77. procedure test1;
  78. begin
  79.   writeln('In test1');
  80.   test2;
  81. end;
  82.  
  83. procedure main;
  84. var
  85.   a : integer;
  86.   s : string[80];
  87. begin
  88.   a := 999;
  89.   s := 'Is this string the same now as it was before?  If its not, then watch out!';
  90.   writeln('In Main start - a is ',a);
  91.   writeln(s);
  92.   SetJmp;                   { set longjmp return point to nxt instruction }
  93.   HereBefore := NOT HereBefore;
  94.   writeln('In main a is ',a);
  95.   writeln(s);
  96.   if NOT HereBefore then
  97.     test1;
  98. end;
  99.  
  100. begin
  101.   writeln('Program starting');
  102.   HereBefore := true;
  103.   main;
  104. end.
  105.